#include "ManagedLasoProvider.h"

real SmartMathLibrary::LasoPack::ManagedLasoProvider::snrm2_(integer *n, real *sx,
  integer *incx)
{
  /* Initialized data */

  static real zero = (float)0.;
  static real one = (float)1.;
  static real cutlo = (float)4.441e-16;
  static real cuthi = (float)1.304e19;

  /* Format strings */
  static char fmt_30[] = "";
  static char fmt_50[] = "";
  static char fmt_70[] = "";
  static char fmt_110[] = "";

  /* System generated locals */
  integer i__1, i__2;
  real ret_val, r__1;

  /* Builtin functions */
  //double sqrt(doublereal);

  /* Local variables */
  static real xmax;
  static integer next, i__, j, nn;
  static real hitest, sum;

  /* Assigned format variables */
  static char *next_fmt;

  /* Parameter adjustments */
  --sx;

  /* Function Body */

  /*     EUCLIDEAN NORM OF THE N-VECTOR STORED IN SX() WITH STORAGE */
  /*     INCREMENT INCX . */
  /*     IF    N .LE. 0 RETURN WITH RESULT = 0. */
  /*     IF N .GE. 1 THEN INCX MUST BE .GE. 1 */

  /*           C.L.LAWSON, 1978 JAN 08 */

  /*     FOUR PHASE METHOD     USING TWO BUILT-IN CONSTANTS THAT ARE */
  /*     HOPEFULLY APPLICABLE TO ALL MACHINES. */
  /*         CUTLO = MAXIMUM OF  SQRT(U/EPS)  OVER ALL KNOWN MACHINES. */
  /*         CUTHI = MINIMUM OF  SQRT(V)      OVER ALL KNOWN MACHINES. */
  /*     WHERE */
  /*         EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. */
  /*         U   = SMALLEST POSITIVE NO.   (UNDERFLOW LIMIT) */
  /*         V   = LARGEST  NO.            (OVERFLOW  LIMIT) */

  /*     BRIEF OUTLINE OF ALGORITHM.. */

  /*     PHASE 1    SCANS ZERO COMPONENTS. */
  /*     MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO */
  /*     MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO */
  /*     MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M */
  /*     WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. */

  /*     VALUES FOR CUTLO AND CUTHI.. */
  /*     FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER */
  /*     DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. */
  /*     CUTLO, S.P.   U/EPS = 2**(-102) FOR  HONEYWELL.  CLOSE SECONDS ARE */
  /*                   UNIVAC AND DEC AT 2**(-103) */
  /*                   THUS CUTLO = 2**(-51) = 4.44089E-16 */
  /*     CUTHI, S.P.   V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. */
  /*                   THUS CUTHI = 2**(63.5) = 1.30438E19 */
  /*     CUTLO, D.P.   U/EPS = 2**(-67) FOR HONEYWELL AND DEC. */
  /*                   THUS CUTLO = 2**(-33.5) = 8.23181D-11 */
  /*     CUTHI, D.P.   SAME AS S.P.  CUTHI = 1.30438D19 */
  /*     DATA CUTLO, CUTHI / 8.232D-11,  1.304D19 / */
  /*     DATA CUTLO, CUTHI / 4.441E-16,  1.304E19 / */

  if (*n > 0)
  {
    goto L10;
  }
  ret_val = zero;
  goto L300;

  L10: next = 0;
  next_fmt = fmt_30;
  sum = zero;
  nn =  *n **incx;
  /*                                                 BEGIN MAIN LOOP */
  i__ = 1;
  L20: switch (next)
  {
    case 0:
      goto L30;
    case 1:
      goto L50;
    case 2:
      goto L70;
    case 3:
      goto L110;
  }
  L30: if ((r__1 = sx[i__], abs(r__1)) > cutlo)
  {
    goto L85;
  }
  next = 1;
  next_fmt = fmt_50;
  xmax = zero;

  /*                        PHASE 1.  SUM IS ZERO */

  L50: if (sx[i__] == zero)
  {
    goto L200;
  }
  if ((r__1 = sx[i__], abs(r__1)) > cutlo)
  {
    goto L85;
  }

  /*                                PREPARE FOR PHASE 2. */
  next = 2;
  next_fmt = fmt_70;
  goto L105;

  /*                                PREPARE FOR PHASE 4. */

  L100: i__ = j;
  next = 3;
  next_fmt = fmt_110;
  sum = sum / sx[i__] / sx[i__];
  L105: xmax = (r__1 = sx[i__], abs(r__1));
  goto L115;

  /*                   PHASE 2.  SUM IS SMALL. */
  /*                             SCALE TO AVOID DESTRUCTIVE UNDERFLOW. */

  L70: if ((r__1 = sx[i__], abs(r__1)) > cutlo)
  {
    goto L75;
  }

  /*                     COMMON CODE FOR PHASES 2 AND 4. */
  /*                     IN PHASE 4 SUM IS LARGE.  SCALE TO AVOID OVERFLOW. */

  L110: if ((r__1 = sx[i__], abs(r__1)) <= xmax)
  {
    goto L115;
  }
  /* Computing 2nd power */
  r__1 = xmax / sx[i__];
  sum = one + sum *(r__1 *r__1);
  xmax = (r__1 = sx[i__], abs(r__1));
  goto L200;

  L115: 
  /* Computing 2nd power */
  r__1 = sx[i__] / xmax;
  sum += r__1 * r__1;
  goto L200;


  /*                  PREPARE FOR PHASE 3. */

  L75: sum = sum * xmax * xmax;


  /*     FOR REAL OR D.P. SET HITEST = CUTHI/N */
  /*     FOR COMPLEX      SET HITEST = CUTHI/(2*N) */

  L85: hitest = cuthi / (real)(*n);

  /*                   PHASE 3.  SUM IS MID-RANGE.  NO SCALING. */

  i__1 = nn;
  i__2 =  *incx;
  for (j = i__; i__2 < 0 ? j >= i__1: j <= i__1; j += i__2)
  {
    if ((r__1 = sx[j], abs(r__1)) >= hitest)
    {
      goto L100;
    }
    /* L95: */
    /* Computing 2nd power */
    r__1 = sx[j];
    sum += r__1 * r__1;
  }
  ret_val = sqrt(sum);
  goto L300;

  L200: i__ +=  *incx;
  if (i__ <= nn)
  {
    goto L20;
  }

  /*              END OF MAIN LOOP. */

  /*              COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. */

  ret_val = xmax * sqrt(sum);
  L300: return ret_val;
} /* snrm2_ */
